home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / OCOMP.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  4.1 KB  |  187 lines
  1. /*
  2.  * File: ocomp.r
  3.  *  Contents: lexeq, lexge, lexgt, lexle, lexlt, lexne, numeq, numge,
  4.  *        numgt, numle, numlt, numne, eqv, neqv
  5.  */
  6.  
  7. /*
  8.  * NumComp is a macro that defines the form of a numeric comparisons.
  9.  */
  10. #begdef NumComp(icon_op, func_name, c_op, descript)
  11. "x " #icon_op " y - test if x is numerically " #descript " y."
  12.    operator{0,1} icon_op func_name(x,y)
  13. #ifdef LargeInts
  14.    declare {
  15.       tended struct descrip lx, ly;
  16.       }
  17. #endif                    /* LargeInts */
  18.    if cnv:(exact)C_integer(x) && cnv:(exact)C_integer(y) then {
  19.       abstract {
  20.          return integer
  21.          }
  22.       inline {
  23.          if c_op(x, y)
  24.             return C_integer y;
  25.          fail;
  26.          }
  27.       }
  28. #ifdef LargeInts
  29.    else if cnv:(exact)integer(x,lx) && cnv:(exact)integer(y,ly) then {
  30.       abstract {
  31.          return integer
  32.          }
  33.       inline {
  34.          if (big_ ## c_op (lx,ly)) {
  35.             return ly;
  36.         }
  37.          fail;
  38.          }
  39.       }
  40. #endif                        /* LargeInts */
  41.    else {
  42.       if !cnv:C_double(x) then
  43.          runerr(102,x)
  44.       if !cnv:C_double(y) then
  45.          runerr(102,y)
  46.       abstract {
  47.          return real
  48.          }
  49.       inline {
  50.          if c_op (x, y)
  51.             return C_double y;
  52.          fail;
  53.          }
  54.       }
  55. end
  56.  
  57. #enddef
  58.  
  59. /*
  60.  * x = y
  61.  */
  62. #define NumEq(x,y) (x == y)
  63. #define big_NumEq(x,y) (bigcmp(&x,&y) == 0)
  64. NumComp( = , numeq, NumEq, equal to)
  65.  
  66. /*
  67.  * x >= y
  68.  */
  69. #define NumGe(x,y) (x >= y)
  70. #define big_NumGe(x,y) (bigcmp(&x,&y) >= 0)
  71. NumComp( >=, numge, NumGe, greater than or equal to)
  72.  
  73. /*
  74.  * x > y
  75.  */
  76. #define NumGt(x,y) (x > y)
  77. #define big_NumGt(x,y) (bigcmp(&x,&y) > 0)
  78. NumComp( > , numgt, NumGt,  greater than)
  79.  
  80. /*
  81.  * x <= y
  82.  */
  83. #define NumLe(x,y) (x <= y)
  84. #define big_NumLe(x,y) (bigcmp(&x,&y) <= 0)
  85. NumComp( <=, numle, NumLe, less than or equal to)
  86.  
  87. /*
  88.  * x < y
  89.  */
  90. #define NumLt(x,y) (x < y)
  91. #define big_NumLt(x,y) (bigcmp(&x,&y) < 0)
  92. NumComp( < , numlt, NumLt,  less than)
  93.  
  94. /*
  95.  * x ~= y
  96.  */
  97. #define NumNe(x,y) (x != y)
  98. #define big_NumNe(x,y) (bigcmp(&x,&y) != 0)
  99. NumComp( ~=, numne, NumNe, not equal to)
  100.  
  101. /*
  102.  * StrComp is a macro that defines the form of a string comparisons.
  103.  */
  104. #begdef StrComp(icon_op, func_name, special_test, c_comp, comp_value, descript)
  105. "x " #icon_op " y - test if x is lexically " #descript " y."
  106. operator{0,1} icon_op func_name(x,y)
  107.    declare {
  108.       int temp_str = 0;
  109.       }
  110.    abstract {
  111.       return string
  112.       }
  113.    if !cnv:tmp_string(x) then
  114.       runerr(103,x)
  115.    if !is:string(y) then 
  116.       if cnv:tmp_string(y) then
  117.           inline {
  118.              temp_str = 1;
  119.              }
  120.       else
  121.          runerr(103,y)
  122.  
  123.    body {
  124.  
  125.       /*
  126.        * lexcmp does the work.
  127.        */
  128.       if (special_test (lexcmp(&x, &y) c_comp comp_value)) {
  129.          /*
  130.           * Return y as the result of the comparison.  If y was converted to
  131.           *  a string, a copy of it is allocated.
  132.           */
  133.          result = y;
  134.          if (temp_str)
  135.             Protect(StrLoc(result) = alcstr(StrLoc(result), StrLen(result)), runerr(0));
  136.          return result;
  137.          }
  138.       else
  139.          fail;
  140.       }
  141. end
  142. #enddef
  143.  
  144. StrComp(==,  lexeq, (StrLen(x) == StrLen(y)) &&, ==, Equal, equal to) 
  145. StrComp(~==, lexne, (StrLen(x) != StrLen(y)) ||, !=, Equal, not equal to)
  146.  
  147. StrComp(>>=, lexge, , !=, Less,    greater than or equal to) 
  148. StrComp(>>,  lexgt, , ==, Greater, greater than)
  149. StrComp(<<=, lexle, , !=, Greater, less than or equal to)
  150. StrComp(<<,  lexlt, , ==, Less,    less than)
  151.  
  152.  
  153. "x === y - test equivalence of x and y."
  154.  
  155. operator{0,1} === eqv(x,y)
  156.    abstract {
  157.       return type(y)
  158.       }
  159.    inline {
  160.       /*
  161.        * Let equiv do all the work, failing if equiv indicates non-equivalence.
  162.        */
  163.       if (equiv(&x, &y))
  164.          return y;
  165.       else
  166.          fail;
  167.    }
  168. end
  169.  
  170.  
  171. "x ~=== y - test inequivalence of x and y."
  172.  
  173. operator{0,1} ~=== neqv(x,y)
  174.    abstract {
  175.       return type(y)
  176.       }
  177.    inline {
  178.       /*
  179.        * equiv does all the work.
  180.        */
  181.       if (!equiv(&x, &y))
  182.          return y;
  183.       else
  184.          fail;
  185.    }
  186. end
  187.